;;; fl.ms
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;; 
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;; 
;;; http://www.apache.org/licenses/LICENSE-2.0
;;; 
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

(mat flonum->fixnum
   (error? (flonum->fixnum))
   (error? (flonum->fixnum 3.3 4.4))
   (error? (flonum->fixnum 3))
   (error? (flonum->fixnum 'a))
   (error? (flonum->fixnum
              (* (inexact (most-positive-fixnum)) 2.0)))
   (error? (flonum->fixnum
              (* (inexact (most-negative-fixnum)) 2.0)))
   (eq? (+ (ash (most-positive-fixnum) -1) 1)
        (flonum->fixnum (* (+ (ash (most-positive-fixnum) -1) 1) 1.0)))
   (eq? (most-negative-fixnum)
        (flonum->fixnum (* (most-negative-fixnum) 1.0)))
   (eq? (+ (ash (most-positive-fixnum) -1) 1)
        (flonum->fixnum (fl+ (* (+ (ash (most-positive-fixnum) -1) 1) 1.0) 0.5)))
   (or (not (fixnum? (inexact->exact (exact->inexact (most-positive-fixnum)))))
       (eq? (most-positive-fixnum)
            (flonum->fixnum (fl+ (* (most-positive-fixnum) 1.0) 0.5))))
   (eq? (most-negative-fixnum)
        (flonum->fixnum (fl- (* (most-negative-fixnum) 1.0) 0.5)))
   (eq? (flonum->fixnum 0.0) 0)
   (eq? (flonum->fixnum 1.0) 1)
   (eq? (flonum->fixnum +4.5) +4)
   (eq? (flonum->fixnum +4.3) +4)
   (eq? (flonum->fixnum +4.0) +4)
   (eq? (flonum->fixnum +3.6) +3)
   (eq? (flonum->fixnum +3.5) +3)
   (eq? (flonum->fixnum +3.4) +3)
   (eq? (flonum->fixnum +3.0) +3)
   (eq? (flonum->fixnum +2.6) +2)
   (eq? (flonum->fixnum +1.0) +1)
   (eq? (flonum->fixnum +.5) 0)
   (eq? (flonum->fixnum -.5) 0)
   (eq? (flonum->fixnum -1.0) -1)
   (eq? (flonum->fixnum -2.6) -2)
   (eq? (flonum->fixnum -3.0) -3)
   (eq? (flonum->fixnum -3.4) -3)
   (eq? (flonum->fixnum -3.5) -3)
   (eq? (flonum->fixnum -3.6) -3)
   (eq? (flonum->fixnum -4.0) -4)
   (eq? (flonum->fixnum -4.3) -4)
   (eq? (flonum->fixnum -4.5) -4)

   (test-cp0-expansion eq? '(+ (ash (most-positive-fixnum) -1) 1)
        (flonum->fixnum (* (+ (ash (most-positive-fixnum) -1) 1) 1.0)))
   (test-cp0-expansion eq? '(most-negative-fixnum)
        (flonum->fixnum (* (most-negative-fixnum) 1.0)))
   (test-cp0-expansion eq? '(flonum->fixnum 0.0) 0)
   (test-cp0-expansion eq? '(flonum->fixnum 1.0) 1)
   (test-cp0-expansion eq? '(flonum->fixnum +4.5) +4)
   (test-cp0-expansion eq? '(flonum->fixnum +4.3) +4)
   (test-cp0-expansion eq? '(flonum->fixnum +4.0) +4)
   (test-cp0-expansion eq? '(flonum->fixnum +3.6) +3)
   (test-cp0-expansion eq? '(flonum->fixnum +3.5) +3)
   (test-cp0-expansion eq? '(flonum->fixnum +3.4) +3)
   (test-cp0-expansion eq? '(flonum->fixnum +3.0) +3)
   (test-cp0-expansion eq? '(flonum->fixnum +2.6) +2)
   (test-cp0-expansion eq? '(flonum->fixnum +1.0) +1)
   (test-cp0-expansion eq? '(flonum->fixnum +.5) 0)
   (test-cp0-expansion eq? '(flonum->fixnum -.5) 0)
   (test-cp0-expansion eq? '(flonum->fixnum -1.0) -1)
   (test-cp0-expansion eq? '(flonum->fixnum -2.6) -2)
   (test-cp0-expansion eq? '(flonum->fixnum -3.0) -3)
   (test-cp0-expansion eq? '(flonum->fixnum -3.4) -3)
   (test-cp0-expansion eq? '(flonum->fixnum -3.5) -3)
   (test-cp0-expansion eq? '(flonum->fixnum -3.6) -3)
   (test-cp0-expansion eq? '(flonum->fixnum -4.0) -4)
   (test-cp0-expansion eq? '(flonum->fixnum -4.3) -4)
   (test-cp0-expansion eq? '(flonum->fixnum -4.5) -4)
)

(mat fixnum->flonum
   (error? (fixnum->flonum))
   (error? (fixnum->flonum 3 4))
   (error? (fixnum->flonum 3.4))
   (error? (fixnum->flonum 'a))
   (error? (fixnum->flonum (+ (most-positive-fixnum) 1)))
   (= (fixnum->flonum (most-positive-fixnum))
      (* (most-positive-fixnum) 1.0))
   (= (fixnum->flonum 0) 0.0)
   (= (fixnum->flonum 1) 1.0)
   (test-cp0-expansion = '(fixnum->flonum (most-positive-fixnum))
      (* (most-positive-fixnum) 1.0))
   (test-cp0-expansion = '(fixnum->flonum 0) 0.0)
   (test-cp0-expansion = '(fixnum->flonum 1) 1.0)
   (test-cp0-expansion = '(fixnum->flonum -1) -1.0)
   (test-cp0-expansion = '(fixnum->flonum -1) -1.0)
)

(mat fl=
   (not (fl= 3.0 4.0))
   (not (fl= 4.0 3.0))
   (fl= 4.1 4.1)
   (not (fl= -4.1 4.1))
   (not (fl= 4.1 -4.1))
   (not (fl= -4.272 -3.272))
   (not (fl= -3.01e-10 -.01e-3))
   (fl= -4e-4)
   (fl= -4e-4 -4e-4)
   (fl= -4e4 -4e4 -4e4)
   (error? (fl=))
   (error? (fl= (list 'a)))
   (error? (fl= 'a 3.1))
   (error? (fl= 3.1 'a))
   (error? (fl= 3.0 3.0 3))
   (error? (fl= 3.0 3.1 3))
   (error? (fl= 3.5 3.5 7/2 4.5))
   (error? (fl= 3.5 4.5 7/2 3.5))
   (guard (c [#t #t]) (fl= 3.0 4.0 (error #f "oops")))
   (guard (c [#t #t]) (fl= 3.0 (error #f "oops") 4.0))
   (guard (c [#t #t]) (fl= (error #f "oops") 3.0 4.0))
   (guard (c [#t #t]) (not (fl= (error #f "oops"))))
 )

(mat fl<
   (fl< 3.0 4.0)
   (not (fl< 4.0 3.0))
   (not (fl< 4.1 4.1))
   (fl< -4.1 4.1)
   (not (fl< 4.1 -4.1))
   (fl< -4.272 -3.272)
   (not (fl< -3.01e-10 -.01e-3))
   (fl< -4e-4)
   (not (fl< -4e-4 -4e-4))
   (not (fl< -4e-4 -4e-4 -4e-4))
   (error? (fl<))
   (error? (fl< (list 'a)))
   (error? (fl< 'a 3.1))
   (error? (fl< 3.1 'a))
   (error? (fl< 3.0 3.1 3))
   (error? (fl< 3.0 3.0 3))
   (error? (fl< 3.5 3.5 7/2 4.5))
   (error? (fl< 3.5 4.5 7/2 3.5))
   (guard (c [#t #t]) (fl< 4.0 3.0 (error #f "oops")))
   (guard (c [#t #t]) (fl< 4.0 (error #f "oops") 3.0))
   (guard (c [#t #t]) (fl< (error #f "oops") 4.0 3.0))
   (guard (c [#t #t]) (not (fl< (error #f "oops"))))
 )

(mat fl>
   (not (fl> 3.0 4.0))
   (fl> 4.0 3.0)
   (not (fl> 4.1 4.1))
   (not (fl> -4.1 4.1))
   (fl> 4.1 -4.1)
   (not (fl> -4.272 -3.272))
   (fl> -3.01e-10 -.01e-3)
   (fl> -4e-4)
   (not (fl> -4e-4 -4e-4))
   (not (fl> -4e-4 -4e-4 -4e-4))
   (error? (fl>))
   (error? (fl> (list 'a)))
   (error? (fl> 'a 3.1))
   (error? (fl> 3.1 'a))
   (error? (fl> 3.1 3.0 3))
   (error? (fl> 3.0 3.0 3))
   (error? (fl> 3.5 3.5 7/2 4.5))
   (error? (fl> 3.5 4.5 7/2 3.5))
   (guard (c [#t #t]) (fl> 3.0 4.0 (error #f "oops")))
   (guard (c [#t #t]) (fl> 3.0 (error #f "oops") 4.0))
   (guard (c [#t #t]) (fl> (error #f "oops") 3.0 4.0))
   (guard (c [#t #t]) (not (fl> (error #f "oops"))))
 )

(mat fl<=
   (fl<= 3.0 4.0)
   (not (fl<= 4.0 3.0))
   (fl<= 4.1 4.1)
   (fl<= -4.1 4.1)
   (not (fl<= 4.1 -4.1))
   (fl<= -4.272 -3.272)
   (not (fl<= -3.01e-10 -.01e-3))
   (fl<= -4e-4)
   (fl<= -4e-4 -4e-4)
   (fl<= -4e-4 -4e-4 -4e-4)
   (error? (fl<=))
   (error? (fl<= (list 'a)))
   (error? (fl<= 'a 3.1))
   (error? (fl<= 3.1 'a))
   (error? (fl<= 3.0 3.0 3))
   (error? (fl<= 3.1 3.0 3))
   (error? (fl<= 3.5 3.5 7/2 4.5))
   (error? (fl<= 3.5 4.5 7/2 3.5))
   (guard (c [#t #t]) (fl<= 4.0 3.0 (error #f "oops")))
   (guard (c [#t #t]) (fl<= 4.0 (error #f "oops") 3.0))
   (guard (c [#t #t]) (fl<= (error #f "oops") 4.0 3.0))
   (guard (c [#t #t]) (not (fl<= (error #f "oops"))))
 )

(mat fl>=
   (not (fl>= 3.0 4.0))
   (fl>= 4.0 3.0)
   (fl>= 4.1 4.1)
   (not (fl>= -4.1 4.1))
   (fl>= 4.1 -4.1)
   (not (fl>= -4.272 -3.272))
   (fl>= -3.01e-10 -.01e-3)
   (fl>= -4e-4)
   (fl>= -4e-4 -4e-4)
   (fl>= -4e-4 -4e-4 -4e-4)
   (error? (fl>=))
   (error? (fl>= (list 'a)))
   (error? (fl>= 'a 3.1))
   (error? (fl>= 3.1 'a))
   (error? (fl>= 3.0 3.0 3))
   (error? (fl>= 3.0 3.1 3))
   (error? (fl>= 3.5 3.5 7/2 4.5))
   (error? (fl>= 3.5 4.5 7/2 3.5))
   (guard (c [#t #t]) (fl>= 3.0 4.0 (error #f "oops")))
   (guard (c [#t #t]) (fl>= 3.0 (error #f "oops") 4.0))
   (guard (c [#t #t]) (fl>= (error #f "oops") 3.0 4.0))
   (guard (c [#t #t]) (not (fl>= (error #f "oops"))))
 )

(mat fl=?
   (not (fl=? 3.0 4.0))
   (not (fl=? 4.0 3.0))
   (fl=? 4.1 4.1)
   (not (fl=? -4.1 4.1))
   (not (fl=? 4.1 -4.1))
   (not (fl=? -4.272 -3.272))
   (not (fl=? -3.01e-10 -.01e-3))
   (fl=? -4e-4 -4e-4)
   (fl=? -4e4 -4e4 -4e4)
   (error? (fl=?))
   (error? (fl=? 3.4))
   (error? (fl=? 'a 3.1))
   (error? (fl=? 3.1 'a))
   (error? (fl=? 3.0 3.0 3))
   (error? (fl=? 3.0 3.1 3))
   (error? (fl=? 3.5 3.5 7/2 4.5))
   (error? (fl=? 3.5 4.5 7/2 3.5))
   (guard (c [#t #t]) (fl=? 3.0 4.0 (error #f "oops")))
   (guard (c [#t #t]) (fl=? 3.0 (error #f "oops") 4.0))
   (guard (c [#t #t]) (fl=? (error #f "oops") 3.0 4.0))
   (guard (c [#t #t]) (not (fl=? (error #f "oops"))))
 )

(mat fl<?
   (fl<? 3.0 4.0)
   (not (fl<? 4.0 3.0))
   (not (fl<? 4.1 4.1))
   (fl<? -4.1 4.1)
   (not (fl<? 4.1 -4.1))
   (fl<? -4.272 -3.272)
   (not (fl<? -3.01e-10 -.01e-3))
   (not (fl<? -4e-4 -4e-4))
   (not (fl<? -4e-4 -4e-4 -4e-4))
   (error? (fl<?))
   (error? (fl<? 3.4))
   (error? (fl<? 'a 3.1))
   (error? (fl<? 3.1 'a))
   (error? (fl<? 3.0 3.1 3))
   (error? (fl<? 3.0 3.0 3))
   (error? (fl<? 3.5 3.5 7/2 4.5))
   (error? (fl<? 3.5 4.5 7/2 3.5))
   (guard (c [#t #t]) (fl<? 4.0 3.0 (error #f "oops")))
   (guard (c [#t #t]) (fl<? 4.0 (error #f "oops") 3.0))
   (guard (c [#t #t]) (fl<? (error #f "oops") 4.0 3.0))
   (guard (c [#t #t]) (not (fl<? (error #f "oops"))))
 )

(mat fl>?
   (not (fl>? 3.0 4.0))
   (fl>? 4.0 3.0)
   (not (fl>? 4.1 4.1))
   (not (fl>? -4.1 4.1))
   (fl>? 4.1 -4.1)
   (not (fl>? -4.272 -3.272))
   (fl>? -3.01e-10 -.01e-3)
   (not (fl>? -4e-4 -4e-4))
   (not (fl>? -4e-4 -4e-4 -4e-4))
   (error? (fl>?))
   (error? (fl>? 3.4))
   (error? (fl>? 'a 3.1))
   (error? (fl>? 3.1 'a))
   (error? (fl>? 3.1 3.0 3))
   (error? (fl>? 3.0 3.0 3))
   (error? (fl>? 3.5 3.5 7/2 4.5))
   (error? (fl>? 3.5 4.5 7/2 3.5))
   (guard (c [#t #t]) (fl>? 3.0 4.0 (error #f "oops")))
   (guard (c [#t #t]) (fl>? 3.0 (error #f "oops") 4.0))
   (guard (c [#t #t]) (fl>? (error #f "oops") 3.0 4.0))
   (guard (c [#t #t]) (not (fl>? (error #f "oops"))))
 )

(mat fl<=?
   (fl<=? 3.0 4.0)
   (not (fl<=? 4.0 3.0))
   (fl<=? 4.1 4.1)
   (fl<=? -4.1 4.1)
   (not (fl<=? 4.1 -4.1))
   (fl<=? -4.272 -3.272)
   (not (fl<=? -3.01e-10 -.01e-3))
   (fl<=? -4e-4 -4e-4)
   (fl<=? -4e-4 -4e-4 -4e-4)
   (error? (fl<=?))
   (error? (fl<=? 3.4))
   (error? (fl<=? 'a 3.1))
   (error? (fl<=? 3.1 'a))
   (error? (fl<=? 3.0 3.0 3))
   (error? (fl<=? 3.1 3.0 3))
   (error? (fl<=? 3.5 3.5 7/2 4.5))
   (error? (fl<=? 3.5 4.5 7/2 3.5))
   (guard (c [#t #t]) (fl<=? 4.0 3.0 (error #f "oops")))
   (guard (c [#t #t]) (fl<=? 4.0 (error #f "oops") 3.0))
   (guard (c [#t #t]) (fl<=? (error #f "oops") 4.0 3.0))
   (guard (c [#t #t]) (not (fl<=? (error #f "oops"))))
 )

(mat fl>=?
   (not (fl>=? 3.0 4.0))
   (fl>=? 4.0 3.0)
   (fl>=? 4.1 4.1)
   (not (fl>=? -4.1 4.1))
   (fl>=? 4.1 -4.1)
   (not (fl>=? -4.272 -3.272))
   (fl>=? -3.01e-10 -.01e-3)
   (fl>=? -4e-4 -4e-4)
   (fl>=? -4e-4 -4e-4 -4e-4)
   (error? (fl>=?))
   (error? (fl>=? 3.4))
   (error? (fl>=? 'a 3.1))
   (error? (fl>=? 3.1 'a))
   (error? (fl>=? 3.0 3.0 3))
   (error? (fl>=? 3.0 3.1 3))
   (error? (fl>=? 3.5 3.5 7/2 4.5))
   (error? (fl>=? 3.5 4.5 7/2 3.5))
   (guard (c [#t #t]) (fl>=? 3.0 4.0 (error #f "oops")))
   (guard (c [#t #t]) (fl>=? 3.0 (error #f "oops") 4.0))
   (guard (c [#t #t]) (fl>=? (error #f "oops") 3.0 4.0))
   (guard (c [#t #t]) (not (fl>=? (error #f "oops"))))
 )

(mat fl+
   (eqv? (fl+) 0.0)
   (eqv? (fl+ -3.0) -3.0)
   (eqv? (fl+ -3.0 4.0) 1.0)
   (eqv? (fl+ (inexact 1/3) (inexact 1/3))
         (+ (inexact 1/3) (inexact 1/3)))
   (eqv? (fl+ 3.25 4.375 5.625) (+ 3.25 4.375 5.625))
   (error? (fl+ '(a . b)))
   (error? (fl+ 2.0 1))
   (error? (fl+ 1.0 -3.0 2/3))
   (string=? (number->string (fl+)) "0.0")
   (test-cp0-expansion eqv? '(fl+) 0.0)
   (test-cp0-expansion eqv? '(fl+ -3.0) -3.0)
   (test-cp0-expansion eqv? '(fl+ -3.0 4.0) 1.0)
   (test-cp0-expansion eqv? 
     '(fl+ (inexact 1/3) (inexact 1/3))
     (+ (inexact 1/3) (inexact 1/3)))
   (test-cp0-expansion eqv? '(fl+ 3.25 4.375 5.625) (+ 3.25 4.375 5.625))
 )

(mat fl-
   (error? (fl-))
   (eqv? (fl- -3.0) 3.0)
   (eqv? (fl- -3.0 4.0) -7.0)
   (eqv? (fl- (inexact 1/3) (inexact 1/7))
         (- (inexact 1/3) (inexact 1/7)))
   (eqv? (fl- 3.25 4.375 5.625) (- 3.25 4.375 5.625))
   (error? (fl- '(a . b)))
   (error? (fl- 2.0 1))
   (error? (fl- 'a 'b))
   (error? (fl- 'a 'b 'c))
   (error? (fl- 1.0 -3.0 2/3))
   (error? (fl- 1.0 'b 2.0))
   (test-cp0-expansion eqv? '(fl- -3.0) 3.0)
   (test-cp0-expansion eqv? '(fl- -3.0 4.0) -7.0)
   (test-cp0-expansion eqv? 
     '(fl- (inexact 1/3) (inexact 1/7))
     (- (inexact 1/3) (inexact 1/7)))
   (test-cp0-expansion eqv? '(fl- 3.25 4.375 5.625) (- 3.25 4.375 5.625))
 )

(mat fl*
   (eqv? (fl*) 1.0)
   (eqv? (fl* -3.0) -3.0)
   (eqv? (fl* -3.0 4.0) -12.0)
   (eqv? (fl* (inexact 1/3) (inexact 1/3))
         (* (inexact 1/3) (inexact 1/3)))
   (eqv? (fl* 3.25 4.375 5.625) (* 3.25 4.375 5.625))
   (error? (fl* '(a . b)))
   (error? (fl* 2.0 1))
   (error? (fl* 1.0 -3.0 2/3))
   (string=? (number->string (fl*)) "1.0")
   (test-cp0-expansion eqv? '(fl*) 1.0)
   (test-cp0-expansion eqv? '(fl* -3.0) -3.0)
   (test-cp0-expansion eqv? '(fl* -3.0 4.0) -12.0)
   (test-cp0-expansion eqv? 
     '(fl* (inexact 1/3) (inexact 1/3))
     (* (inexact 1/3) (inexact 1/3)))
   (test-cp0-expansion eqv? '(fl* 3.25 4.375 5.625) (* 3.25 4.375 5.625))
 )

(mat fl/
   (error? (fl/))
   (eqv? (fl/ -3.0) (/ -3.0))
   (eqv? (fl/ -3.0 4.0) -.75)
   (eqv? (fl/ (inexact 1/3) (inexact 1/7))
         (/ (inexact 1/3) (inexact 1/7)))
   (eqv? (fl/ 3.25 4.375 5.625) (/ 3.25 4.375 5.625))
   (error? (fl/ '(a . b)))
   (error? (fl/ 2.0 1))
   (error? (fl/ 1.0 -3.0 2/3))
   (test-cp0-expansion eqv? '(fl/ -3.0) (/ -3.0))
   (test-cp0-expansion eqv? '(fl/ -3.0 4.0) -.75)
   (test-cp0-expansion eqv? 
     '(fl/ (inexact 1/3) (inexact 1/7))
     (/ (inexact 1/3) (inexact 1/7)))
   (test-cp0-expansion eqv? '(fl/ 3.25 4.375 5.625) (/ 3.25 4.375 5.625))
 )

(mat flabs
    (error? (flabs))
    (error? (flabs 1 2))
    (error? (flabs 'a))
    (error? (flabs 1))
    (error? (flabs -3/4))
    (error? (flabs 3+4i))
    (error? (flabs 3.3+4.5i))
    (fl~= (flabs 1.83) 1.83)
    (fl~= (flabs -0.093) 0.093)
    (== (flabs -0.0) 0.0)
    (== (flabs 0.0) 0.0)
    (== (flabs +inf.0) +inf.0)
    (== (flabs -inf.0) +inf.0)
    (== (flabs +nan.0) +nan.0)
    (eqv? (flabs 0.0) 0.0)
    (eqv? (flabs -1.0) 1.0)
    (eqv? (flabs 1.0) 1.0)
 )

(mat fllog
    (error? (fllog))
    (error? (fllog 3)) 
    (error? (fllog 'a))
    (error? (fllog 0))
    (fl~= (fllog 1.0) 0.0)
    (fl~= (fllog (exp 7.0)) 7.0) 
    (fl~= (fllog (exp 10.2)) 10.2)
    (fl~= (fllog 1e30) (inexact (log #e1e30)))
    (fl~= (/ (log (expt 10 500)) (fllog 10.0)) 500.0)
    (fl~= (log 3/4) (fllog .75))
    (fl~= (fllog 10.0 10.0) 1.0)
    (fl~= (fllog 50.0 50.0) 1.0)
    (fl~= (fllog 1000.0 10.0) 3.0)
   ; r6rs:
    (== (fllog +inf.0) +inf.0)
    (== (fllog 0.0) -inf.0)
    (== (fllog -inf.0) +nan.0)
 )

(mat flexp
    (error? (flexp))
    (error? (flexp 3.0 4.0)) 
    (error? (flexp 'a))
    (error? (flexp 3))
    (fl= (flexp 0.0) 1.0)
    (~= (* (flexp 1.0) (flexp 1.0)) (flexp 2.0))
    (fl~= (/ (flexp 24.2) (flexp 2.0)) (flexp 22.2))
   ; r6rs:
    (== (flexp +inf.0) +inf.0)
    (== (flexp -inf.0) 0.0)
 )

(mat flsin
    (and (> pi 3.14159265) (< pi 3.14159266))
    (error? (flsin))
    (error? (flsin 3.0 4.0)) 
    (error? (flsin 'a))
    (error? (flsin 3))
    (fl~= (flsin (/ pi 6)) 0.5)
 )

(mat flcos
    (error? (flcos))
    (error? (flcos 3.0 4.0)) 
    (error? (flcos 'a))
    (error? (flcos 3))
    (fl~= (flcos (/ pi 3)) 0.5)
    (let ([x 3.3])
       (let ([s (flsin x)] [c (flcos x)])
          (~= (+ (* s s) (* c c)) 1.0)))
 )

(mat fltan
    (error? (fltan))
    (error? (fltan 3.0 4.0)) 
    (error? (fltan 'a))
    (error? (fltan 3))
    (fl~= (fltan (/ pi 4)) 1.0)
    (let ([x 4.4]) (~= (fltan x) (/ (flsin x) (flcos x))))
 )

(mat flasin
    (error? (flasin))
    (error? (flasin 3.0 4.0)) 
    (error? (flasin 'a))
    (error? (flasin 3))
    (fl~= (flasin 1.0) (/ pi 2))
    (let ([x 1.0]) (fl~= (flasin (flsin x)) x))
    (let ([x 0.5]) (fl~= (flasin (flsin x)) x))
 )

(mat flacos
    (error? (flacos))
    (error? (flacos 3.0 4.0)) 
    (error? (flacos 'a))
    (error? (flacos 3))
    (fl~= (flacos 0.5) (/ pi 3))
    (let ([x 0.5]) (fl~= (flacos (flcos x)) x))
 )

(mat flatan
    (error? (flatan))
    (error? (flatan 3.0 4.0 5.0)) 
    (error? (flatan 'a))
    (error? (flatan 'a 3.0))
    (error? (flatan 3.0 'a))
    (error? (flatan 3 4))
    (error? (flatan +i))
    (error? (flatan -i))
    (fl~= (flatan 1.0) (/ pi 4))
    (fl~= (flatan 2.0 2.0) (/ pi 4))
    (let ([x 0.5]) (fl~= (flatan (fltan x)) x))
    (fl~= (flatan 10.0 -10.0) (angle -10+10i))
    (fl~= (flatan 10.0 -10.0) (angle -10.0+10.0i))
    (fl~= (flatan 10.0 -10.0) (flatan 10.0 -10.0))
   ; r6rs:
    (== (flatan -inf.0) -1.5707963267948965)
    (== (flatan +inf.0) 1.5707963267948965)
 )

(mat flsqrt
    (error? (flsqrt))
    (error? (flsqrt 3.0 4.0)) 
    (error? (flsqrt 'a))
    (error? (flsqrt 3))
    (== (flsqrt -1.0) (nan))
    (~= (flsqrt 9.0) 3.0)
    (~= (flsqrt #i1/4) #e1/2)
    (~= (* (flsqrt 189.0) (flsqrt 189.0)) 189.0)
    (fl~= (* (flsqrt 2.0) (flsqrt 2.0)) 2.0)
    (~= (flsqrt 1e38) (sqrt #e1e38))
   ; r6rs:
    (== (flsqrt +inf.0) +inf.0)
    (== (flsqrt -0.0) -0.0)
 )

(mat flexpt
    (error? (flexpt))
    (error? (flexpt 5.0))
    (error? (flexpt 3.0 4.0 5.0))
    (error? (flexpt 'a 3.0))
    (error? (flexpt 3.0 'a))
    (error? (flexpt 0.0 -1))
    (error? (flexpt 0.0 +1i))
    (fl~= (flexpt 10.0 -20.0) 1e-20)
    (eqv? (flexpt 2.0 10.0) 1024.0)
    (eqv? (flexpt 0.0 0.0) 1.0)
    (eqv? (flexpt 0.0 2.0) 0.0)
    (eqv? (flexpt 100.0 0.0) 1.0)
    (eqv? (flexpt 2.0 -10.0) #i1/1024)
    (eqv? (flexpt #i-1/2 #i5) #i-1/32)
    (fl~= (flexpt 9.0 #i1/2) 3.0)
    (fl~= (flexpt 3.0 3.0) 27.0)
    (~= (flexpt -0.5 2.0) .25)
    (~= (flexpt -0.5 -2.0) 4.0)
    (~= (flexpt 3.0 2.5) (flsqrt (* 3.0 3.0 3.0 3.0 3.0)))
    (fl= (flexpt 0.0 2.0) 0.0)
    (fl= (flexpt 0.0 0.0) 1.0)
    (fl= (flexpt 2.0 0.0) 1.0)
    (fl~= (flexpt #i-2/3 #i-3) #i-27/8)
    (fl= (flexpt 10.0 -1000.0) 0.0)
    (fl= (flexpt .1 1000.0) 0.0)
    (~= (flexpt #i11 #i1/2) (flsqrt #i11))
    (fl~= (flexpt 1.5e-20 0.5) (flsqrt 1.5e-20))
    (equal?
      (let ([ls '(a b c)])
        (let ([n (flexpt (begin (set! ls (append ls ls)) 2.0)
                         (begin (set! ls (reverse ls)) 3.0))])
          (cons n ls)))
      '(8.0 c b a c b a))
 )

(mat fltruncate
    (error? (fltruncate))
    (error? (fltruncate 2.0 3.0))
    (error? (fltruncate 'a))
    (error? (fltruncate 3))
    (error? (fltruncate 2+1.0i))
    (error? (fltruncate 2+1i))
    (eqv? (fltruncate 19.0) 19.0)
    (eqv? (fltruncate #i2/3) 0.0)
    (fl~= (fltruncate #i-2/3) 0.0)
    (fl= (fltruncate #i17.3) 17.0)
    (eqv? (fltruncate #i-17/2) -8.0)
    (fl= (fltruncate 2.5) 2.0)
   ; r6rs:
    (== (fltruncate +nan.0) +nan.0)
 )

(mat flfloor
    (error? (flfloor))
    (error? (flfloor 2.0 3.0))
    (error? (flfloor 'a))
    (error? (flfloor 3))
    (error? (flfloor 2+1.0i))
    (error? (flfloor 2+1i))
    (eqv? (flfloor 19.0) 19.0)
    (eqv? (flfloor #i2/3) 0.0)
    (eqv? (flfloor #i-2/3) -1.0)
    (fl= (flfloor #i17.3) 17.0)
    (eqv? (flfloor #i-17/2) -9.0)
    (fl= (flfloor 2.5) 2.0)
   ; r6rs:
    (== (flfloor +inf.0) +inf.0)
 )

(mat flceiling
    (error? (flceiling))
    (error? (flceiling 2.0 3.0))
    (error? (flceiling 'a))
    (error? (flceiling 3))
    (error? (flceiling 2+1.0i))
    (eqv? (flceiling 19.0) 19.0)
    (eqv? (flceiling #i2/3) 1.0)
    (fl~= (flceiling #i-2/3) 0.0)
    (fl= (flceiling #i17.3) 18.0)
    (eqv? (flceiling #i-17/2) -8.0)
    (fl= (flceiling 2.5) 3.0)
   ; r6rs:
    (== (flceiling -inf.0) -inf.0)
 )

(mat flround
    (error? (flround))
    (error? (flround 2.0 3))
    (error? (flround 'a))
    (error? (flround 2+1.0i))
    (error? (flround 2+1i))
    (error? (flround 19))
    (error? (flround 2/3))
    (fl= (flround 17.3) 17.0)
    (fl= (flround 2.5) 2.0)
    (fl= (flround 0.5000000000000000) 0.0)
    (fl= (flround 0.5000000000000001) 1.0)
    (eqv? (flround 0.0) 0.0)
    (eqv? (flround -0.0) -0.0)
    (eqv? (flround 0.5) 0.0)
    (eqv? (flround -0.5) -0.0)
    (fl= (flround -0.5000000000000001) -1.0)
 )

(mat flsingle
    (error? (flsingle))
    (error? (flsingle 2.0 3.0))
    (error? (flsingle 'a))
    (error? (flsingle 3))
    (error? (flsingle 2+1.0i))
    (error? (flsingle 2+1i))
    (eqv? (flsingle 19.0) 19.0)
    (eqv? (flsingle -19.0) -19.0)
    (eqv? (flsingle +nan.0) +nan.0)
    (eqv? (flsingle +inf.0) +inf.0)
    (eqv? (flsingle -inf.0) -inf.0)
    (fl~= (flsingle 1.25e38) 1.2500000360947476e38)
    (fl~= (flsingle 1.25e-37) 1.2500000449239123e-37)
    (fl~= (flsingle -1.25e38) -1.2500000360947476e38)
    (fl~= (flsingle -1.25e-37) -1.2500000449239123e-37)
    (eqv? (flsingle 1e100) +inf.0)
    (eqv? (flsingle -1e100) -inf.0)
    (eqv? (flsingle 1e-100) 0.0)
    (eqv? (flsingle -1e-100) -0.0)
 )

(mat flinteger?
    (error? (flinteger? 'a))
    (error? (flinteger? "hi"))
    (error? (flinteger? (cons 3 4)))
    (error? (flinteger? 3.0+0.0i))
    (error? (flinteger? 3.0+1.0i))
    (flinteger? 3.0)
    (flinteger? 23048230482304.0)
    (not (flinteger? #i-3/4))
    (flinteger? -1.0)
    (flinteger? 0.0)
    (flinteger? -12083.0)
    (flinteger? 4.0)
    (not (flinteger? 3.5))
    (not (flinteger? 1.8e-10))
    (flinteger? 1.8e10)
    (flinteger? -3e5)
    (not (flinteger? -1231.2344))
 )

(mat flnan?
  (error? (flnan? 3))
  (error? (flnan? 3/4))
  (error? (flnan? 'hi))
  (flnan? (nan))
  (not (flnan? 5.0))
  (not (flnan? +inf.0))
  (not (flnan? -inf.0))
)

(mat flfinite?
  (error? (flfinite? 3))
  (error? (flfinite? 3/4))
  (error? (flfinite? 'hi))
  (not (flfinite? (nan)))
  (flfinite? 5.0)
  (not (flfinite? +inf.0))
  (not (flfinite? -inf.0))
 ; r6rs:
  (not (flfinite? +inf.0))
  (flfinite? 5.0)
)

(mat flinfinite?
  (error? (flinfinite? 3))
  (error? (flinfinite? 3/4))
  (error? (flinfinite? 'hi))
  (not (flinfinite? (nan)))
  (not (flinfinite? 5.0))
  (flinfinite? +inf.0)
  (flinfinite? -inf.0)
 ; r6rs:
  (not (flinfinite? 5.0))
  (flinfinite? +inf.0)
)

(mat flzero?
    (error? (flzero?))
    (error? (flzero? 0.0 1.0))
    (error? (flzero? 'a))
    (error? (flzero? 3))
    (flzero? 0.0)
    (flzero? #i0/5)
    (not (flzero? 234.0))
    (not (flzero? #i23423423/234241211))
    (not (flzero? 23.4))
    (not (flzero? -1734234.0))
    (not (flzero? #i-2/3))
    (not (flzero? -0.1))
 )

(mat flpositive?
    (error? (flpositive?))
    (error? (flpositive? 0.0 1.0))
    (error? (flpositive? 'a))
    (error? (flpositive? 3))
    (error? (flpositive? 1+1.0i))
    (error? (flpositive? 1+1i))
    (not (flpositive? 0.0))
    (not (flpositive? #i0/5))
    (flpositive? 234.0)
    (flpositive? #i23423423/234241211)
    (flpositive? 23.4)
    (not (flpositive? -1734234.0))
    (not (flpositive? #i-2/3))
    (not (flpositive? -0.1))
 )

(mat flnegative?
    (error? (flnegative?))
    (error? (flnegative? 0.0 1.0))
    (error? (flnegative? 'a))
    (error? (flnegative? 3))
    (error? (flnegative? 1+1.0i))
    (error? (flnegative? 1+1i))
    (not (flnegative? 0.0))
    (not (flnegative? #i0/5))
    (not (flnegative? 234.0))
    (not (flnegative? #i23423423/234241211))
    (not (flnegative? 23.4))
    (flnegative? -1734234.0)
    (flnegative? #i-2/3)
    (flnegative? -0.1)
   ; r6rs:
    (not (flnegative? -0.0))
 )

(mat flnonpositive?
    (error? (flnonpositive?))
    (error? (flnonpositive? 0.0 1.0))
    (error? (flnonpositive? 'a))
    (error? (flnonpositive? 3))
    (error? (flnonpositive? 1+1.0i))
    (error? (flnonpositive? 1+1i))
    (flnonpositive? 0.0)
    (flnonpositive? #i0/5)
    (not (flnonpositive? 234.0))
    (not (flnonpositive? #i23423423/234241211))
    (not (flnonpositive? 23.4))
    (flnonpositive? -1734234.0)
    (flnonpositive? #i-2/3)
    (flnonpositive? -0.1)
 )

(mat flnonnegative?
    (error? (flnonnegative?))
    (error? (flnonnegative? 0.0 1.0))
    (error? (flnonnegative? 'a))
    (error? (flnonnegative? 3))
    (error? (flnonnegative? 1+1i))
    (error? (flnonnegative? 1.0+1.0i))
    (flnonnegative? 0.0)
    (flnonnegative? #i0/5)
    (flnonnegative? 234.0)
    (flnonnegative? #i23423423/234241211)
    (flnonnegative? 23.4)
    (not (flnonnegative? -1734234.0))
    (not (flnonnegative? #i-2/3))
    (not (flnonnegative? -0.1))
 )

(mat fleven?
    (error? (fleven?))
    (error? (fleven? 0.0 1.0))
    (error? (fleven? 'a))
    (error? (fleven? 3))
    (error? (fleven? 3.2))
    (error? (fleven? 3.0+1.0i))
    (error? (fleven? 1+1i))
    (error? (fleven? +inf.0))
    (error? (fleven? +nan.0))
    (not (fleven? -3.0))
    (fleven? 2.0)
    (not (fleven? 1208312083280477.0))
    (fleven? 1208312083280478.0)
    (fleven? 4.0)
    (not (fleven? 3.0))
 )

(mat flodd?
    (error? (flodd?))
    (error? (flodd? 0.0 1.0))
    (error? (flodd? 'a))
    (error? (flodd? 3))
    (error? (flodd? 3.2))
    (error? (flodd? 3.0+1.0i))
    (error? (flodd? 3+1i))
    (error? (flodd? +inf.0))
    (error? (flodd? +nan.0))
    (flodd? -3.0)
    (not (flodd? 2.0))
    (flodd? 1208312083280477.0)
    (not (flodd? 1208312083280478.0))
    (not (flodd? 4.0))
    (flodd? 3.0)
 )

(mat flmin
    (error? (flmin))
    (error? (flmin 'a))
    (error? (flmin 1.0 'a))
    (error? (flmin 1.0 'a 2.0))
    (error? (flmin 1.0 3 2.0))
    (error? (flmin 1.0 2.0 3.0 'a))
    (error? (flmin 1.0 2.0 3.0 0+1.0i))
    (error? (flmin 1.0 2.0 3.0 +1i))
    (eqv? (flmin -17.0) -17.0)
    (eqv? (flmin 3.0 -3.0) -3.0)
    (eqv? (flmin 3.2 1.0) 1.0)
    (fl= (flmin 3.2 1.0) 1.0)
    (fl= (flmin #i1/2 0.5) 0.5)
    (fl= (flmin #i-1/2 0.5) -0.5)
    (eqv? (flmin 3.0 5.0 1.0 4.0 6.0 2.0) 1.0)
    (== (flmin 4.5 (nan)) (nan))
    (== (flmin (nan) 4.5) (nan))
    (== (flmin +inf.0 (nan)) (nan))
    (== (flmin (nan) +inf.0) (nan))
    (== (flmin -inf.0 (nan)) (nan))
    (== (flmin (nan) -inf.0) (nan))
    (== (flmin 3.0 4.5 (nan) 17.3 -1.5) (nan))
    (fl= (flmin 3.0 4.5 +inf.0 17.3 -1.5) -1.5)
    (fl= (flmin 3.0 4.5 -inf.0 17.3 -1.5) -inf.0)
 )

(mat flmax
    (error? (flmax))
    (error? (flmax 'a))
    (error? (flmax 1.0 'a))
    (error? (flmax 1.0 3))
    (error? (flmax 1.0 'a 2.0))
    (error? (flmax 1.0 2.0 3.0 'a))
    (error? (flmax 1.0 2.0 3.0 0+1.0i))
    (error? (flmax 1.0 2.0 3.0 +1i))
    (eqv? (flmax 1.0) 1.0)
    (eqv? (flmax 3.0 -3.0) 3.0)
    (fl= (flmax 3.2 1.0) 3.2)
    (fl= (flmax 3.2 1.0) 3.2)
    (fl= (flmax #i1/2 0.5) 0.5)
    (fl= (flmax #i1/2 -0.5) 0.5)
    (eqv? (flmax 3.0 5.0 1.0 4.0 6.0 2.0) 6.0)
    (== (flmax 4.5 (nan)) (nan))
    (== (flmax (nan) 4.5) (nan))
    (== (flmax +inf.0 (nan)) (nan))
    (== (flmax (nan) +inf.0) (nan))
    (== (flmax -inf.0 (nan)) (nan))
    (== (flmax (nan) -inf.0) (nan))
    (== (flmax 3.0 4.5 (nan) 17.3 -1.5) (nan))
    (fl= (flmax 3.0 4.5 +inf.0 17.3 -1.5) +inf.0)
    (fl= (flmax 3.0 4.5 -inf.0 17.3 -1.5) 17.3)
 )

(mat flnumerator
    (error? (flnumerator))
    (error? (flnumerator 3.0 4.0)) 
    (error? (flnumerator 'a))
    (error? (flnumerator 3))
    (error? (flnumerator +1i))
    (error? (flnumerator 2.2+1.1i))
    (eqv? (flnumerator 3.25) 13.0)
    (eqv? (flnumerator 9.0) 9.0)
    (fl~= (let ([n (flnumerator #i2/3)] [d (fldenominator #i2/3)]) (/ n d)) #i2/3)
    (fl~= (flnumerator #i-9/4) -9.0)
    (== (flnumerator +nan.0) +nan.0)
   ; r6rs:
    (== (flnumerator +inf.0) +inf.0)
    (== (flnumerator -inf.0) -inf.0)
    (== (flnumerator 0.75) 3.0)
 )

(mat fldenominator
    (error? (fldenominator))
    (error? (fldenominator 3.0 4.0)) 
    (error? (fldenominator 'a))
    (error? (fldenominator 3))
    (error? (fldenominator +1i))
    (error? (fldenominator 2.2+1.1i))
    (eqv? (fldenominator 3.25) 4.0)
    (eqv? (fldenominator 9.0) 1.0)
    (eqv? (fldenominator #i-9/4) 4.0)
    (== (fldenominator +nan.0) +nan.0)
   ; r6rs:
    (== (fldenominator +inf.0) 1.0)
    (== (fldenominator -inf.0) 1.0)
    (== (fldenominator 0.75) 4.0)
 )

(mat fldiv-and-mod
 ; fldiv-and-mod
  (error? (fldiv-and-mod 17 3.0))
  (error? (fldiv-and-mod 3.0 17))
  (error? (fldiv-and-mod 'a 17.0))
  (error? (fldiv-and-mod 17.0 '(a)))
 ; fldiv
  (error? (fldiv 17 3.0))
  (error? (fldiv 3.0 17))
  (error? (fldiv 'a 17.0))
  (error? (fldiv 17.0 '(a)))
 ; flmod
  (error? (flmod 17 3.0))
  (error? (flmod 3.0 17))
  (error? (flmod 'a 17.0))
  (error? (flmod 17.0 '(a)))
 ; fldiv-and-mod
  (begin
    (define $d&m fldiv-and-mod)
    (define ($dmpair x y) (call-with-values (lambda () ($d&m x y)) cons))
    (define ($dmpairs x y)
      (list ($dmpair x y) ($dmpair (- x) y) ($dmpair x (- y)) ($dmpair (- x) (- y))
            ($dmpair y x) ($dmpair (- y) x) ($dmpair y (- x)) ($dmpair (- y) (- x))))
    (define ($dmequal? x y)
      (cond
        [(pair? x)
         (and (pair? y)
              ($dmequal? (car x) (car y))
              ($dmequal? (cdr x) (cdr y)))]
        [(number? x)
         (and (number? y)
              (if (inexact? x)
                  (and (inexact? y) (== x y))
                  (and (exact? y) (= x y))))]
        [else (eq? x y)]))
    #t)
  ($dmequal?
    ($dmpairs 0.0 3.5)
    '((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
      (+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
  ($dmequal?
    ($dmpairs 3.5 11.25)
    '((0.0 . 3.5) (-1.0 . 7.75) (-0.0 . 3.5) (1.0 . 7.75)
      (3.0 . 0.75) (-4.0 . 2.75) (-3.0 . 0.75) (4.0 . 2.75)))
 ; fldiv with flmod
  (begin
    (set! $d&m (lambda (x y) (values (fldiv x y) (flmod x y))))
    #t)
  ($dmequal?
    ($dmpairs 0.0 3.5)
    '((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
      (+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
  ($dmequal?
    ($dmpairs 3.5 11.25)
    '((0.0 . 3.5) (-1.0 . 7.75) (-0.0 . 3.5) (1.0 . 7.75)
      (3.0 . 0.75) (-4.0 . 2.75) (-3.0 . 0.75) (4.0 . 2.75)))
)

(mat fldiv0-and-mod0
 ; fldiv0-and-mod0
  (error? (fldiv0-and-mod0 17 3.0))
  (error? (fldiv0-and-mod0 3.0 17))
  (error? (fldiv0-and-mod0 'a 17.0))
  (error? (fldiv0-and-mod0 17.0 '(a)))
 ; fldiv0
  (error? (fldiv0 17 3.0))
  (error? (fldiv0 3.0 17))
  (error? (fldiv0 'a 17.0))
  (error? (fldiv0 17.0 '(a)))
 ; flmod0
  (error? (flmod0 17 3.0))
  (error? (flmod0 3.0 17))
  (error? (flmod0 'a 17.0))
  (error? (flmod0 17.0 '(a)))
 ; fldiv0-and-mod0
  (begin
    (define $d&m fldiv0-and-mod0)
    (define ($dmpair x y) (call-with-values (lambda () ($d&m x y)) cons))
    (define ($dmpairs x y)
      (list ($dmpair x y) ($dmpair (- x) y) ($dmpair x (- y)) ($dmpair (- x) (- y))
            ($dmpair y x) ($dmpair (- y) x) ($dmpair y (- x)) ($dmpair (- y) (- x))))
    #t)
  ($dmequal?
    ($dmpairs 0.0 3.5)
    '((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
      (+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
  ($dmequal?
    ($dmpairs 3.5 11.25)
    '((0.0 . 3.5) (0.0 . -3.5) (-0.0 . 3.5) (0.0 . -3.5)
      (3.0 . 0.75) (-3.0 . -0.75) (-3.0 . 0.75) (3.0 . -0.75)))
  ($dmequal?
    ($dmpairs 10.0 4.0)
    '((3.0 . -2.0) (-2.0 . -2.0) (-3.0 . -2.0) (2.0 . -2.0)
      (0.0 . 4.0) (0.0 . -4.0) (-0.0 . 4.0) (0.0 . -4.0)))
 ; fldiv0 with flmod0
  (begin
    (set! $d&m (lambda (x y) (values (fldiv0 x y) (flmod0 x y))))
    #t)
  ($dmequal?
    ($dmpairs 0.0 3.5)
    '((0.0 . 0.0) (-0.0 . 0.0) (-0.0 . 0.0) (0.0 . 0.0)
      (+inf.0 . +nan.0) (-inf.0 . +nan.0) (-inf.0 . +nan.0) (+inf.0 . +nan.0)))
  ($dmequal?
    ($dmpairs 3.5 11.25)
    '((0.0 . 3.5) (0.0 . -3.5) (-0.0 . 3.5) (0.0 . -3.5)
      (3.0 . 0.75) (-3.0 . -0.75) (-3.0 . 0.75) (3.0 . -0.75)))
  ($dmequal?
    ($dmpairs 10.0 4.0)
    '((3.0 . -2.0) (-2.0 . -2.0) (-3.0 . -2.0) (2.0 . -2.0)
      (0.0 . 4.0) (0.0 . -4.0) (-0.0 . 4.0) (0.0 . -4.0)))
)

(mat fp-unboxing
  (begin
    (define-syntax check-loop-allocation
      (syntax-rules ()
        [(_ proc) ; proc should allocate only its result flonum
         (or (eq? (current-eval) interpret)
             (#%$suppress-primitive-inlining)
             (let ([before (+ (bytes-allocated) (bytes-deallocated))]
                   [N 100000])
               (and
                (box?
                 (let loop ([i N] [bx (box 0.0)])
                   (if (zero? i)
                       bx
                       (loop (sub1 i) (let ([v (unbox bx)])
                                        (box (proc v)))))))
                (let ([allocated (- (+ (bytes-allocated) (bytes-deallocated)) before)]
                      [expected (* N (+ (compute-size 1.0)
                                        (compute-size (box #f))))])
                  (printf "~s ~s\n" allocated expected)
                  (<= expected allocated (* 1.2 expected))))))]))
    #t)

  (check-loop-allocation (lambda (v) (fl+ v v)))
  (check-loop-allocation (lambda (v) (fl* v v)))
  (check-loop-allocation (lambda (v) (fl- v 1.0)))
  (check-loop-allocation (lambda (v) (fl/ v 2.0)))

  (check-loop-allocation (lambda (v) (fl+ v 2.0 v)))
  (check-loop-allocation (lambda (v) (fl+ v (fl* 2.0 v))))

  (check-loop-allocation (lambda (v) (fl+ v v v)))
  (check-loop-allocation (lambda (v) (fl+ v (fl* v v) (fl/ v 2.0))))

  (check-loop-allocation (lambda (v) (flabs v)))
  (check-loop-allocation (lambda (v) (fl- v)))

  (check-loop-allocation (lambda (v) (flabs (fl+ v v))))
  (check-loop-allocation (lambda (v) (fl- (fl+ v v))))

  (check-loop-allocation (lambda (v) (flround v)))
  (check-loop-allocation (lambda (v) (fltruncate v)))
  (check-loop-allocation (lambda (v) (flfloor v)))
  (check-loop-allocation (lambda (v) (flceiling v)))
  
  (check-loop-allocation (lambda (v) (flsqrt v)))
  (check-loop-allocation (lambda (v) (flsin v)))
  (check-loop-allocation (lambda (v) (flcos v)))
  (check-loop-allocation (lambda (v) (fltan v)))
  (check-loop-allocation (lambda (v) (flasin v)))
  (check-loop-allocation (lambda (v) (flacos v)))
  (check-loop-allocation (lambda (v) (flatan v)))
  (check-loop-allocation (lambda (v) (flatan v v)))
  (check-loop-allocation (lambda (v) (flexp v)))
  (check-loop-allocation (lambda (v) (fllog v)))
  (check-loop-allocation (lambda (v) (fllog v v)))
  (check-loop-allocation (lambda (v) (flexpt v v)))

  (let ([i 0])
    (check-loop-allocation (lambda (v) (begin
                                         (set! i (add1 i))
                                         (fl+ v (fixnum->flonum i))))))
  (let ([i 0])
    (check-loop-allocation (lambda (v) (begin
                                         (set! i (flonum->fixnum v))
                                         (fl+ v 1.0)))))

  (check-loop-allocation (lambda (v) (let ([u (fl+ v v)])
                                       (fl* u u))))

  (check-loop-allocation (lambda (v) (if (fl= (fl+ v (fl* 2.0 v)) 7.0)
                                         (fl+ v 1.0)
                                         (fl- v 1.0))))
  (check-loop-allocation (lambda (v) (if (fl< (fl+ v v) v)
                                         (fl+ v 1.0)
                                         (fl- v 1.0))))
  (check-loop-allocation (lambda (v) (if (fl> (fl+ v v) v)
                                         (fl+ v 1.0)
                                         (fl- v 1.0))))
  (check-loop-allocation (lambda (v) (if (fl<= (fl+ v v) v)
                                         (fl+ v 1.0)
                                         (fl- v 1.0))))
  (check-loop-allocation (lambda (v) (if (fl>= (fl+ v v) v)
                                         (fl+ v 1.0)
                                         (fl- v 1.0))))

  (check-loop-allocation (lambda (v)
                           ;; The two single-argument `fl+`s here should work as
                           ;; a hint for unboxing in the loop
                           (let loop ([n 100] [v (fl+ v)])
                             (if (fx= n 0)
                                 (fl+ v)
                                 (loop (fx- n 1) (fl+ v 1.0))))))

  (let ([bv (make-bytevector 8 0)])
    (check-loop-allocation (lambda (v) (fl+ v (bytevector-ieee-double-native-ref bv 0)))))
  (let ([bv (make-bytevector 8 0)])
    (check-loop-allocation (lambda (v) (begin
                                         (bytevector-ieee-double-native-set! bv 0 (fl+ v 0.1))
                                         (fl* v 0.99)))))
  (let ([bv (make-bytevector 8 0)])
    (check-loop-allocation (lambda (v) (let ([v (fl+ v 1.0)])
                                         (bytevector-ieee-double-native-set! bv 0 v)
                                         (fl* v 0.99)))))
  (let ([flv (make-flvector 8 0.0)])
    (check-loop-allocation (lambda (v) (fl+ v (flvector-ref flv 0)))))
  (let ([flv (make-flvector 8 0.0)])
    (check-loop-allocation (lambda (v) (let ([v (fl+ v 1.0)])
                                         (flvector-set! flv 0 v)
                                         (fl* v 0.99)))))
  (or (not (enable-cp0))
      (let ()
        (define-record pseudo-random-generator
          ((mutable double x10) (mutable double x11) (mutable double x12)
           (mutable double x20) (mutable double x21) (mutable double x22))
          ())
        (let ([s (make-pseudo-random-generator 1.0 2.0 3.0 4.0 5.0 6.0)])
          (check-loop-allocation (lambda (v) (let ([v (fl+ (pseudo-random-generator-x10 s) 1.0)])
                                               (set-pseudo-random-generator-x11! s v)
                                               (set-pseudo-random-generator-x12! s v)
                                               (pseudo-random-generator-x20 s)))))))

  (begin
    (define many-compare
      (lambda (a b c d e f g h i j k)
        (fl<= a b c d e f g h i j k)))
    (many-compare 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0 11.0))

  (begin
    (define many-add
      (lambda (a b c d e f g h i j k)
        (fl+ a b c d e f g h i j k)))
    (fl= 66.0 (many-add 1.0 2.0 3.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0 11.0)))

  (eqv? (let ([x 4.0]) (fl+ x)) 4.0)
  (eqv? (let ([x 4.0]) (fl+ (fl- x 1.0))) 3.0)
  (eqv? (let ([x 5.0]) (fl* x)) 5.0)

  )
